#!/usr/bin/perl
###############################################################################
# TODO superceded by scdimg2tile
# makeTile PAL.ASM:p0 TITLE.BMP 0 > TITLE.ASM

use strict;
use warnings;

if ( $#ARGV < 5 ) {
    die "\nscdmaketile <palfile>:[pb]<int> <bmp> <sprite> <tileoffset> <compress> <magicpink>\n\n";
}

my $paletteInfo = shift @ARGV;
my $bmpInfo = shift @ARGV;
my $sprite = shift @ARGV;
my $tileOffset = shift @ARGV;
my $compress = shift @ARGV;
my $magicPink = shift @ARGV;

my @tiles;

my $bmpLabel = $bmpInfo;
$bmpLabel =~ s/\..*$//g;

my $bitsPerPixel = 4;
my $bmpData = '';
my $bmpDataSize = 0;
my @bmpPaletteToSegaPalette;

my $paletteData = &ReadPalette($paletteInfo);

my $tileData = &ReadBMP($bmpInfo);

sub ReadPalette {
    my ($paletteInfo) = @_;
    my $paletteType = 'p';
    my $paletteOffset = 0;
    if ( $paletteInfo !~ m/^([^:]+):([pb])([0-9]+)$/ &&
	 $paletteInfo !~ m/^([^:]+)$/ ) {
	die "Bad palette info: $paletteInfo";
    }
    my $paletteFile = $1;
    if ( defined $2 ) {
	$paletteType = $2;
    }
    if ( defined $3 ) {
	$paletteOffset = $3;
    }
    if ( $paletteType eq 'p' ) {
	$paletteOffset *= 32;
    }
    if ( ! -e $paletteFile ) {
	die "Bad palette file: $paletteFile";
    }
    if ( $paletteFile =~ m/\.asm$/i ) {
	my $paletteAsmFile = $paletteFile;
	$paletteFile = 'TMP.BIN';
	system("scdasm $paletteAsmFile $paletteFile");
	if ( ! -e $paletteFile ) {
	    die "Bad scdasm since didn't make: $paletteFile";
	}
    }

    my $paletteData = chr(0x00)x32;

    open( PALETTE, $paletteFile ) or die "Cannot read palette file: $!\n";
    binmode PALETTE;
    seek(PALETTE,$paletteOffset,0);
    my $paletteDataBuffer;
    if ( read(PALETTE,$paletteDataBuffer,32) == 32 ) {
	$paletteData = $paletteDataBuffer;
    }
    close PALETTE;

    return $paletteData;
}

sub Convert3BitColorTo8BitColor {
    my ($bit3) = @_;
    return int( ( $bit3 & 0x07 ) * 0xFF / 0x07 + 0.5 );
}

sub Convert8BitColorTo3BitColor {
    my ($bit8) = @_;
    return int( ( $bit8 & 0xFF ) * 0x07 / 0xFF + 0.5 );
}

sub ReadBMP {
    my ($bmpFile) = @_;

    open( BMP, "$bmpFile" ) or die "Cannot write bmp: $!\n";

    binmode BMP;

    my $buffer;

    # BM
    read(BMP,$buffer,2);
    &BadBMP("BM") if $buffer ne 'BM';
    # size
    read(BMP,$buffer,4);
    my $size = unpack("V",$buffer);
    &BadBMP("size") if $size != ( -s $bmpFile );
    # reserved
    read(BMP,$buffer,2);
    # reserved
    read(BMP,$buffer,2);
    # start of BMP data
    read(BMP,$buffer,4);
    my $dataStart = unpack("V",$buffer);

    # length of this header
    read(BMP,$buffer,4);
    my $headerLength = unpack("V",$buffer);
    my $width = 8;
    my $height = 8;
    $bmpDataSize = $size - $dataStart;
    my $paletteSize = 0;
    if ( $headerLength == 0x28 ) {
	# width
	read(BMP,$buffer,4);
	$width = unpack("V",$buffer);
	&BadBMP("width") if $width == 0 || $width % 8;
	# height
	read(BMP,$buffer,4);
	$height = unpack("V",$buffer);
	&BadBMP("height") if $height == 0 || $height % 8;
	# 1 plane
	read(BMP,$buffer,2);
	&BadBMP("plane") if unpack("v",$buffer) != 1;
	# bits/pixel
	read(BMP,$buffer,2);
	$bitsPerPixel = unpack("v",$buffer);
	&BadBMP("bits/pixel") if ( $bitsPerPixel != 1 && $bitsPerPixel != 2 && $bitsPerPixel != 4 );
	# no compression
	read(BMP,$buffer,4);
	&BadBMP("compression") if unpack("V",$buffer) != 0;
	# size of raw BMP data (0x20 bytes)
	read(BMP,$buffer,4);
	my $dataSize = unpack("V",$buffer);
	&BadBMP("datasize") if $bmpDataSize != $dataSize;
	# horizontal resolution
	read(BMP,$buffer,4);
	# vertical resolution
	read(BMP,$buffer,4);
	# 16 colors in palette
	read(BMP,$buffer,4);
	$paletteSize = unpack("V",$buffer);
	&BadBMP("plane") if $paletteSize > 16;
	# number of important colors
	read(BMP,$buffer,4);
    } else {
	&BadBMP("headerlength");
    }

    # start of palette (BGR)

    for ( my $pIndex = 0; $pIndex < $paletteSize; $pIndex++ ) {
	read(BMP,$buffer,4);
	my $pValue = unpack("N",$buffer);
	my $segaColorValue =
	    ( &Convert8BitColorTo3BitColor($pValue >> 24) << 9 ) |
	    ( &Convert8BitColorTo3BitColor($pValue >> 16) << 5 ) |
	    ( &Convert8BitColorTo3BitColor($pValue >>  8) << 1 );
	if ( $magicPink && $segaColorValue == ((7<<9)|(7<<1)) ) {
	    $bmpPaletteToSegaPalette[$pIndex] = 0;
	} else {
	    my $segaColor = pack("n",$segaColorValue);
	    $bmpPaletteToSegaPalette[$pIndex] = &GetPaletteIndex($segaColor);
	}
    }

    # check the bmp data size
    &BadBMP("bmpdatasize/width x height") if $bmpDataSize * 8 != $bitsPerPixel * &WidthAccountingForQuadByteBoundary($width) * $height;

    seek(BMP,$dataStart,0);
    read(BMP,$bmpData,$bmpDataSize);
    close BMP;

    my $w = $width / 8;
    my $h = $height / 8;
    my $tileCount = $bmpDataSize * 8 / $bitsPerPixel / 64;
    if ( $sprite ) {
	print " ;; sprite ordering from (${w}x${h})\n";
	for ( my $col = 0; $col < $width; $col += 8 ) {
	    for ( my $row = 0; $row < $height; $row += 8 ) {
		ReadBMPTile($row,$col,$width,$height);
	    }
	}
    } else {
	print " ;; map (${w}x${h})\n";
	print "Start${bmpLabel}Map:\n";
	for ( my $row = 0; $row < $height; $row += 8 ) {
	    my $map;
	    for ( my $col = 0; $col < $width; $col += 8 ) {
		my $tileUsed = ReadBMPTile($row,$col,$width,$height);
		$map .= chr($tileUsed);
	    }
	    print " dc.b ";
	    for ( my $i = 0; $i < length($map); $i++ ) {
		print ',' if $i;
		printf("\$%2.2X",ord(substr($map,$i,1)));
	    }
	    print "\n";
	    if ( $row == 0 ) {
		print "StartRow${bmpLabel}Map:\n";
	    }
	}
	print "End${bmpLabel}Map:\n";
    }

    print "Start${bmpLabel}Tiles:\n";
    if ( $compress ) {
	print " ;; compressed $compress\n";
    }
    for ( my $tileIndex = 0; $tileIndex <= $#tiles; $tileIndex++ ) {
	printf(" ;; tile \$%2.2X\n",$tileIndex+$tileOffset);
	if ( $compress == 0 ) {
	    for ( my $i = 0; $i < length($tiles[$tileIndex]); $i += 4 ) {
		printf(" dc.l \$%8.8X\n",unpack("N",substr($tiles[$tileIndex],$i,4)));
	    }
	} elsif ( $compress == 1 ) {
	    for ( my $i = 0; $i < length($tiles[$tileIndex]); $i += 4 ) {
		my $v0 = unpack("n",substr($tiles[$tileIndex],$i,2));
		my $v1 = unpack("n",substr($tiles[$tileIndex],$i+2,2));
		my $value = $v0 | ( $v1 << 2 );
		printf(" dc.w \$%4.4X\n",$value);
	    }
	} elsif ( $compress == 2 ) {
	    for ( my $i = 0; $i < length($tiles[$tileIndex]); $i += 8 ) {
		my $v0 = unpack("n",substr($tiles[$tileIndex],$i,2));
		my $v1 = unpack("n",substr($tiles[$tileIndex],$i+2,2));
		my $v2 = unpack("n",substr($tiles[$tileIndex],$i+4,2));
		my $v3 = unpack("n",substr($tiles[$tileIndex],$i+6,2));
		my $value = $v0 | ( $v1 << 1 ) | ( $v2 << 2 ) | ( $v3 << 3 );
		printf(" dc.w \$%4.4X\n",$value);
	    }
	} else {
	    die "Unsupported compress argument\n";
	}
    }
    print "End${bmpLabel}Tiles:\n";
    
}

sub WidthAccountingForQuadByteBoundary {
    my ($width) = @_;
    # convert width to bits, then place on 32 bit boundary, then
    # convert back to "width"
    return 32*int(($width*$bitsPerPixel+31)/32)/$bitsPerPixel;
}

sub ReadBMPTile {
    my ($row,$col,$width,$height) = @_;
    my $tile = '';
    for ( my $subrow = 0; $subrow < 8; $subrow++ ) {
	# rows are backwards from sega ordering
	my $bmpDataIndex = (&WidthAccountingForQuadByteBoundary($width)*($height-$row-$subrow-1)+$col)/(8/$bitsPerPixel);
	# process 8 pixels
	if ( $bmpDataIndex + $bitsPerPixel > length($bmpData) ) {
	    die "Bad bmpDataIndex: $row $col $subrow $width $height $bmpDataIndex/$bmpDataSize\n";
	}
	my $tileData = substr($bmpData,$bmpDataIndex,$bitsPerPixel);
	my $value = 0;
	if ( $bitsPerPixel == 1 ) {
	    $value = ord($tileData);
	} elsif ( $bitsPerPixel == 2 ) {
	    $value = unpack("v",$tileData);
	} else {
	    $value = unpack("V",$tileData);
	}
	my $mask = ( ( 1 << $bitsPerPixel ) - 1 );
	# process each of the resulting four bytes
	for ( my $i = 0; $i < 4; $i++ ) {
	    my $valueHi = ( ( $value >> ( $bitsPerPixel * ( 7 - 2 * $i ) ) ) & $mask );
	    my $valueLo = ( ( $value >> ( $bitsPerPixel * ( 7 - 2 * $i - 1 ) ) ) & $mask );
	    #my $value = ord(substr($tileData,$i,1));
	    #my $valueHi = ( $value >> 4 ) & 0x0F;
	    #my $valueLo = ( $value      ) & 0x0F;
	    if ( $valueHi > $#bmpPaletteToSegaPalette ||
		 $valueLo > $#bmpPaletteToSegaPalette ) {
		&BadBMP("bmpdatavalue: $valueHi $valueLo");
	    }
	    my $segaValue =
		( $bmpPaletteToSegaPalette[$valueHi] << 4 ) | $bmpPaletteToSegaPalette[$valueLo];
	    $tile .= chr($segaValue);
	}
    }
    my $tileUsed = -1;
    if ( ! $sprite ) {
	for ( my $tileIndex = 0; $tileIndex <= $#tiles; $tileIndex++ ) {
	    if ( $tiles[$tileIndex] eq $tile ) {
		$tileUsed = $tileIndex + $tileOffset;
		last;
	    }
	}
    }
    if ( $tileUsed < 0 ) {
	push @tiles, $tile;
	$tileUsed = $#tiles + $tileOffset;
    }
    return $tileUsed;
}


sub BadBMP {
    my ($msg) = @_;
    die "BadBMP($msg)\n";
}

sub GetPaletteIndex {
    my ($color) = @_;
    # start with 1 to avoid picking transparent index
    # do check index 0 if no other matches found
    for ( my $i = 1; $i <= 16; $i++ ) {
	my $pColor = substr($paletteData,($i%16)*2,2);
	if ( $color eq $pColor ) {
	    return $i;
	}
    }
    my $c = sprintf("0x%4.4X",unpack("n",$color));
    print STDERR "Palette does not contain color: $c\n";
    return 0;
}
